home *** CD-ROM | disk | FTP | other *** search
/ SuperHack / SuperHack CD.bin / CODING / VBASIC / VBPIANO.ZIP / PIANO.BAS < prev    next >
Encoding:
BASIC Source File  |  1995-08-01  |  3.2 KB  |  71 lines
  1. Attribute VB_Name = "PIANO1"
  2. #If Win32 Then
  3.    Public Declare Function midiOutClose Lib "winmm.dll" (ByVal hMidiOut As Long) As Long
  4.    Public Declare Function midiOutOpen Lib "winmm.dll" (lphMidiOut As Long, ByVal uDeviceID As Long, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal dwFlags As Long) As Long
  5.    Public Declare Function midiOutShortMsg Lib "winmm.dll" (ByVal hMidiOut As Long, ByVal dwMsg As Long) As Long
  6.    Public Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
  7.    Public Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
  8. #Else
  9.    Public Declare Function midiOutOpen Lib "mmsystem.dll" Alias "MidiOutOpen" (hMidiOut As Long, ByVal DeviceId As Integer, ByVal C As Long, ByVal I As Long, ByVal F As Long) As Integer
  10.    Public Declare Function midiOutShortMsg Lib "mmsystem.dll" Alias "MidiOutShortMsg" (ByVal hMidiOut As Integer, ByVal MidiMessage As Long) As Integer
  11.    Public Declare Function midiOutClose Lib "mmsystem.dll" Alias "MidiOutClose" (ByVal hMidiOut As Integer) As Integer
  12.    Public Declare Function GetPrivateProfileString Lib "kernel" (ByVal Sname$, ByVal Kname$, ByVal Def$, ByVal Ret$, ByVal Size%, ByVal Fname$) As Integer
  13.    Public Declare Function sndPlaySound Lib "mmsystem" (ByVal lpsSound As String, ByVal wFlag As Integer) As Integer
  14. #End If
  15.  
  16. Global MidiEventOut, MidiNoteOut, MidiVelOut As Long
  17. Global hMidiOut As Long
  18. Global hMidiOutCopy As Long
  19. Global MidiOpenError As String
  20.  
  21. Global Const MODAL = 1
  22. Global Const ShiftKey = 1
  23.  
  24. ' The Patch number array used for current patch for each midi channel
  25. ' Then Volume array used for each channels volume setting
  26. ' TrackChannel is array for the current midi channel that that Track on the mixi is set to.
  27. Global MidiPatch(16), MidiVolume(16), TrackChannel(16), MidiPan(16), Octave(16) As Integer
  28.  
  29. ' The current Midi Channel out set on Piano form
  30. Global MidiChannelOut As Integer
  31.  
  32. ' The Velocity (Volume) of notes for current midi channel
  33. Global MidiVelocity As Integer
  34.  
  35. 'Boolean for it CapsLock has been pressed or not
  36. Global CapsLock As Integer
  37.  
  38. ' NoteRepeat used to stop the same key from repeating.  CapsLock detects if it is down.
  39. Global NoteRepeat As Integer
  40.  
  41.  
  42. Sub MidiOutOpenPort()
  43.    MidiOpenError = Str$(midiOutOpen(hMidiOut, -1, 0, 0, 0))
  44.    hMidiOutCopy = hMidiOut
  45. End Sub
  46.  
  47. Sub ReadPatch()
  48. Dim Sname As String, Ret As String, Ext As String
  49.     
  50.    Ret = String$(255, 0)
  51.    Default1$ = Ret
  52.    Sname = "General MIDI"
  53.    Ext = Str$(MidiPatch(MidiChannelOut))
  54.    filename$ = App.Path & "\PATCH.INI"
  55.    nSize = GetPrivateProfileString(Sname, Ext, Default1$, Ret, Len(Ret), filename$)
  56.    Piano.PatchLabel.Caption = Ret
  57. End Sub
  58.  
  59. Sub SendMidiOut()
  60. Dim MidiMessage As Long
  61. Dim lowint As Long
  62. Dim highint As Long
  63.     
  64.    lowint = (MidiNoteOut * 256) + MidiEventOut
  65.    highint = (MidiVelOut * 256) * 256
  66.  
  67.    MidiMessage = lowint + highint
  68.    X% = midiOutShortMsg(hMidiOutCopy, MidiMessage)
  69. End Sub
  70.  
  71.